home *** CD-ROM | disk | FTP | other *** search
/ CD Actual 80 / CD Actual 80 Julio-Agosto 2003.iso / Linux / LinuxGazette / lg / issue12 / misc / tclvu.tcl
Encoding:
Tcl/Tk script  |  2002-08-14  |  23.4 KB  |  774 lines
  1. #!/usr/local/bin/wish
  2. #
  3. # tclvu.tcl      A small Tcl/Tk app that allows the user to view the 
  4. #                contents of a tar or tar+gzip file and optionally
  5. #                view/edit/save a file within the archive.
  6. #
  7. # Copyright (c) 1996 John M. Fisk <fiskjm@ctrvax.vanderbilt.edu>
  8. #
  9. # VERSION:
  10. # $Id: tclvu.tcl,v 1.1.1.1 2002/08/14 22:26:57 dan Exp $
  11.  
  12.  
  13. # GLOBAL DEFINITIONS
  14. #
  15. # print command definition
  16. set lprCmd        "lpr"
  17.  
  18. # tar and tgz 'find' recognition strings
  19. set tarStr "tar archive"
  20. set tgzStr "gzip compressed data"
  21.  
  22.  
  23. #######################################################################
  24. # PROCEDURE DEFINITIONS
  25. #######################################################################
  26.  
  27. proc CreateWindow {} {
  28. #
  29. # creates the top level window and sets the listbox and button bindings
  30. # for these widgets
  31.  
  32.     global pathname 
  33.     global filename
  34.     global tarType
  35.     global tarStr
  36.     global tgzStr
  37.  
  38.     # DEFINE WM ATTRIBS
  39.     wm title . "TclVu Tar Archive Viewer"
  40.  
  41.     # DEFINE FRAMES
  42.     frame .frPath -bd 2 -relief groove
  43.     frame .frFile -bd 2
  44.     frame .frDir  -bd 2 -relief groove
  45.     frame .frBut  -bd 2 -relief sunken
  46.     pack .frPath \
  47.          .frFile \
  48.          .frDir \
  49.          .frBut \
  50.          -side top -fill x -expand false -padx 1m -pady 1m
  51.  
  52.     # DEFINE PATH ENTRY BOX AND UP BUTTON
  53.     label .frPath.lblPath -text "Path: "
  54.     set PTH [entry .frPath.entPath -width 80 -relief sunken \
  55.         -textvariable pathname]
  56.     bind $PTH <Return> {
  57.         if [file isdirectory $pathname] {
  58.             cd $pathname
  59.             set filename ""
  60.             DirList $pathname
  61.         } else {
  62.             set pathname [pwd]
  63.         }
  64.     }
  65.     button .frPath.btnPathUp -text "Up.." -command {
  66.         if [file isdirectory $pathname] {
  67.             cd ..
  68.             set pathname [pwd]
  69.             DirList $pathname
  70.         } else {
  71.             set pathname [string range $pathname 0 [expr [string last / \
  72.                 $pathname] -1]]
  73.             set filename ""
  74.             DirList $pathname
  75.         }
  76.     }
  77.     pack .frPath.lblPath -side left -expand false -padx 1m
  78.     pack .frPath.entPath -side left -expand false -padx 1m -pady 2m
  79.     pack .frPath.btnPathUp -side right -expand false -padx 1m
  80.  
  81.     # FILE LABEL AND ENTRY BOX
  82.     label .frFile.lblFile -text "File: "
  83.     entry .frFile.entFile -width 32 -textvariable filename -relief flat \
  84.         -foreground red -font 9x15
  85.     pack  .frFile.lblFile \
  86.           .frFile.entFile \
  87.           -side left -expand false -padx 1m -pady 0.25m
  88.  
  89.     # DIRECTORY LISTBOX
  90.     set LB [listbox .frDir.lbxDir -relief raised -bd 2 -yscrollcommand \
  91.         ".frDir.sbDir set" -width 72 -height 12 -font 8x13]
  92.     scrollbar .frDir.sbDir -command ".frDir.lbxDir yview"
  93.  
  94.     bind $LB <Double-Button-1> {
  95.         #
  96.         # BIND DOUBLE CLICK IN LISTBOX
  97.         # since we're using a long directory listing, create a tmp
  98.         # list and get the file/dir name from the last item in the list
  99.  
  100.         # PARSE SELECTION
  101.         foreach i [split [selection get] \ ] {
  102.             lappend lst $i
  103.         }
  104.         set fname [lindex $lst [expr [llength $lst] -1]]
  105.  
  106.         if [file isdirectory $fname] {
  107.             cd $fname
  108.             set pathname [pwd]
  109.             DirList $pathname
  110.         } elseif [file isfile $fname] {
  111.             if [regexp $tarStr [exec file $fname]] {
  112.                 set pathname "$pathname/$fname"
  113.                 set tarType tar
  114.                 TarList $fname
  115.             } elseif [regexp $tgzStr [exec file $fname]] {
  116.                 set pathname "$pathname/$fname"
  117.                 set tarType tgz
  118.                 TarList $fname
  119.             } else {
  120.             }
  121.         } else {
  122.             if [file isfile $pathname] {
  123.                 if [regexp $tarStr [exec file $pathname]] {
  124.                     set tarType tar
  125.                     TarView $pathname [selection get]
  126.                 } elseif [regexp $tgzStr [exec file $pathname]] {
  127.                     set tarType tgz
  128.                     TarView $pathname [selection get]
  129.                 } else {
  130.                 }
  131.             }
  132.         }
  133.     }
  134.     bind $LB <ButtonRelease-1> {
  135.         #
  136.         # BIND SINGLE CLICK IN LISTBOX
  137.         # only set the filename if in directory listing
  138.         # mode; if in tar archive listing mode, leave the
  139.         # archive filename in the File entry box
  140.  
  141.         foreach i [split [selection get] \ ] {
  142.             lappend lst $i
  143.         }
  144.         set fname [lindex $lst [expr [llength $lst] -1]]
  145.         if [file isdirectory $pathname] {
  146.             if [file isfile $fname] {
  147.                 set filename $fname
  148.             } else {
  149.                 set filename ""
  150.             }
  151.         }
  152.     }
  153.     bind $LB <ButtonRelease-3> { .frBut.btnSave invoke }
  154.     pack .frDir.sbDir -side right -fill y
  155.     pack .frDir.lbxDir -side left -fill both -expand true
  156.  
  157.     # COMMAND BUTTONS
  158.     button .frBut.btnView -text "View/Edit..." -command {
  159.         foreach i [split [selection get] \ ] {
  160.             lappend lst $i
  161.         }
  162.         set fname [lindex $lst [expr [llength $lst] -1]]
  163.  
  164.         if [file isdirectory $fname] {
  165.             cd $fname
  166.             set pathname [pwd]
  167.             DirList $pathname
  168.         } elseif [file isfile $fname] {
  169.             if [regexp $tarStr [exec file $fname]] {
  170.                 set pathname "$pathname/$fname"
  171.         set tarType tar
  172.                 TarList $fname
  173.             } elseif [regexp $tgzStr [exec file $fname]] {
  174.                 set pathname "$pathname/$fname"
  175.         set tarType tgz
  176.                 TarList $fname
  177.             } else {
  178.             }
  179.         } else {
  180.             if [file isfile $pathname] {
  181.                 if [regexp $tarStr [exec file $pathname]] {
  182.                     set tarType tar
  183.                     TarView $pathname [selection get]
  184.                 } elseif [regexp $tgzStr [exec file $pathname]] {
  185.                     set tarType tgz
  186.                     TarView $pathname [selection get]
  187.                 } else {
  188.                 }
  189.             }
  190.         }
  191.     }
  192.     button .frBut.btnSave -text "Save..." -command {
  193.         if [file isfile $pathname] {
  194.             SaveFile $pathname [selection get]
  195.         }
  196.     }
  197.     button .frBut.btnPrnt -text "Print..." -command {
  198.         if [file isfile $pathname] {
  199.             if [regexp $tarStr [exec file $pathname]] {
  200.                 set tarType tar
  201.                 PrintFile $pathname [selection get]
  202.             } elseif [regexp $tgzStr [exec file $pathname]] {
  203.                 set tarType tgz
  204.                 PrintFile $pathname [selection get]
  205.             } else {
  206.             }
  207.         }
  208.     }
  209.     button .frBut.btnQuit -text "Quit" -command { exit }
  210.     pack .frBut.btnView \
  211.          .frBut.btnSave \
  212.          .frBut.btnPrnt \
  213.          .frBut.btnQuit \
  214.          -side left -fill x -expand true -padx 2m -pady 2m
  215. }
  216. # END CreateWindow ----------------------------------------------------
  217.  
  218.  
  219. proc PrintFile { tarfile sfile } {
  220. #
  221. # displays a small dialog box requesting print command
  222.  
  223.     global tarType
  224.     global lprCmd
  225.     global aFile
  226.     global sFile
  227.  
  228.     # DEFINE VARs
  229.     set aFile $tarfile
  230.     set sFile $sfile
  231.  
  232.     # DEFINE TOPLEVEL WINDOW
  233.     toplevel .prt
  234.     wm title .prt "TclVu Printing $sfile"
  235.  
  236.     # DEFINE FRAMES
  237.     frame .prt.frEnt -relief groove -bd 2
  238.     frame .prt.frBut -relief sunken -bd 2
  239.     pack  .prt.frEnt \
  240.           .prt.frBut \
  241.           -side top -fill x -expand false -padx 2m -pady 2m
  242.  
  243.     # DEFINE LPR COMMAND ENTRY BOX
  244.     label .prt.frEnt.lbl -text "Enter print command: "
  245.     entry .prt.frEnt.ent -textvariable lprCmd -width 24
  246.     pack  .prt.frEnt.lbl -side left -expand false
  247.     pack  .prt.frEnt.ent -side left -fill x -expand true
  248.  
  249.     # DEFINE PRINT AND CANCEL BUTTONS
  250.     button .prt.frBut.butPrnt -text "Print" -command {
  251.         if {$tarType == "tar"} {
  252.             eval exec tar -xOf $aFile $sFile | $lprCmd -
  253.             destroy .prt
  254.         } elseif {$tarType == "tgz"} {
  255.             eval exec tar -xzOf $aFile $sFile | $lprCmd -
  256.             destroy .prt
  257.         } else {
  258.         }
  259.     }
  260.     button .prt.frBut.butCncl -text "Cancel" -command { destroy .prt }
  261.     pack .prt.frBut.butPrnt \
  262.          .prt.frBut.butCncl \
  263.          -side left -fill x -expand true -padx 2m -pady 2m
  264. }
  265. # END PrintFile -------------------------------------------------------
  266.  
  267.  
  268. proc SaveFile { tarfile sfile } {
  269. #
  270. # displays a directory browser window from which the selected file
  271. # may be saved or appended to a file
  272.  
  273.     global tarType
  274.     global dirname
  275.     global aFile
  276.     global sFile
  277.     global sFilename
  278.     global tmpPWD
  279.  
  280.     # SET VARs
  281.     set dirname [pwd]
  282.     set aFile $tarfile
  283.     set sFile $sfile
  284.     set sFilename "$dirname/"
  285.     set tmpPWD [pwd]
  286.  
  287.     # DEFINE TOPLEVEL WINDOW
  288.     toplevel .save
  289.     wm title .save "TclVu Saving File: $sfile"
  290.  
  291.     # DEFINE FRAMES
  292.     frame .save.frLbl -relief groove -bd 2
  293.     frame .save.frLbx -relief groove -bd 2
  294.     frame .save.frEnt -relief flat   -bd 2
  295.     frame .save.frBut -relief sunken -bd 2
  296.     pack  .save.frLbl \
  297.           .save.frLbx \
  298.           .save.frEnt \
  299.           .save.frBut \
  300.           -side top -fill x -expand true -padx 2m -pady 2m
  301.  
  302.     # DEFINE TOPMOST DIRECTORY LABEL AND BUTTONS
  303.     label .save.frLbl.lblDir -text "Directory: "
  304.     entry .save.frLbl.entDir -textvariable dirname -width 72
  305.     button .save.frLbl.butUp -text "Up.." -command {
  306.         cd ..
  307.         set dirname [pwd]
  308.         set sFilename "$dirname/"
  309.         set dirlist [exec ls -al $dirname]
  310.         .save.frLbx.lbxDir delete 0 end
  311.         foreach i [split $dirlist "\n"] {
  312.             .save.frLbx.lbxDir insert end $i
  313.         }
  314.     }
  315.     pack  .save.frLbl.lblDir \
  316.           .save.frLbl.entDir \
  317.           -side left -fill x -expand true -padx 2m -pady 2m
  318.     pack  .save.frLbl.butUp -side right -expand false -padx 2m -pady 2m
  319.  
  320.     # DEFINE DIRECTORY ENTRYBOX <RETURN> BINDING
  321.     bind .save.frLbl.entDir <Return> {
  322.         if [file isdirectory $dirname] {
  323.             cd $dirname
  324.             set sFilename "$dirname/"
  325.             set dirlist [exec ls -al $dirname]
  326.             .save.frLbx.lbxDir delete 0 end
  327.             foreach i [split $dirlist "\n"] {
  328.                 .save.frLbx.lbxDir insert end $i
  329.             }
  330.         } else {
  331.             set dirname [pwd]
  332.         }
  333.     }
  334.  
  335.     # DEFINE DIRECTORY LISTBOX AND SCROLLBAR
  336.     listbox .save.frLbx.lbxDir -relief raised -bd 2 -yscrollcommand \
  337.         ".save.frLbx.sbDir set" -width 72 -height 12 -font 8x13
  338.     scrollbar .save.frLbx.sbDir -command ".save.frLbx.lbxDir yview"
  339.     pack .save.frLbx.sbDir -side right -fill y
  340.     pack .save.frLbx.lbxDir -side left -fill x -expand true
  341.  
  342.     # DEFINE LISTBOX DOUBLE CLICK EVENT
  343.     bind .save.frLbx.lbxDir <Double-Button-1> {
  344.         foreach i [split [selection get] \ ] {
  345.             lappend lst $i
  346.         }
  347.         set fname [lindex $lst [expr [llength $lst] -1]]
  348.  
  349.         if [file isdirectory $fname] {
  350.             cd $fname
  351.             set dirname [pwd]
  352.             set sFilename "$dirname/"
  353.             set dirlist [exec ls -al $dirname]
  354.             .save.frLbx.lbxDir delete 0 end
  355.             foreach i [split $dirlist "\n"] {
  356.                 .save.frLbx.lbxDir insert end $i
  357.             }
  358.         } elseif [file isfile $fname] {
  359.             set sFilename "$dirname/$fname"
  360.         } else {
  361.         }
  362.     }
  363.     # DEFINE LISTBOX SINGLE CLICK EVENT
  364.     bind .save.frLbx.lbxDir <ButtonRelease-1> {
  365.             foreach i [split [selection get] \ ] {
  366.             lappend lst $i
  367.         }
  368.         set fname [lindex $lst [expr [llength $lst] -1]]
  369.  
  370.         if [file isfile $fname] {
  371.             set sFilename "$dirname/$fname"
  372.         } elseif [file isdirectory $fname] {
  373.             set sFilename "$dirname/"
  374.         } else {
  375.         }
  376.     }
  377.  
  378.     # GET INITIAL DIRECTORY LISTING
  379.     .save.frLbx.lbxDir delete 0 end
  380.     set dirlist [exec ls -al $dirname]
  381.     foreach i [split $dirlist "\n"] {
  382.         .save.frLbx.lbxDir insert end $i
  383.     }
  384.  
  385.     # DEFINE FILENAME ENTRY BOX
  386.     label .save.frEnt.lbl -text "Filename: "
  387.     entry .save.frEnt.ent -textvariable sFilename -width 72
  388.     pack  .save.frEnt.lbl -side left -pady 2m
  389.     pack  .save.frEnt.ent -side left -fill x -pady 0.5m
  390.  
  391.     # DEFINE OPERATION BUTTONS
  392.     # SAVE AS BUTTON
  393.     button .save.frBut.butSave -text "Save As" -command {
  394.         if [file exists $sFilename] {
  395.             set sFilename "$dirname/"
  396.         } else {
  397.             if {$tarType == "tar"} {
  398.                 exec tar -xOf $aFile $sFile > $sFilename
  399.             } elseif {$tarType == "tgz"} {
  400.                 exec tar -xzOf $aFile $sFile > $sFilename
  401.             } else {
  402.             }
  403.             cd $tmpPWD
  404.             destroy .save
  405.         }
  406.     }
  407.     # APPEND BUTTON
  408.     button .save.frBut.butApnd -text "Append" -command {
  409.         if {![file isfile $sFilename]} {
  410.             set sFilename "$dirname/"
  411.         } else {
  412.             if {$tarType == "tar"} {
  413.                 exec tar -xOf $aFile $sFile >> $sFilename
  414.             } elseif {$tarType == "tgz"} {
  415.                 exec tar -xzOf $aFile $sFile >> $sFilename
  416.             } else {
  417.             }
  418.             cd $tmpPWD
  419.             destroy .save
  420.         }        
  421.     }
  422.     # QUIT BUTTON
  423.     button .save.frBut.butQuit -text "Quit" -command { cd $tmpPWD; destroy .save }
  424.     pack .save.frBut.butSave \
  425.          .save.frBut.butApnd \
  426.          .save.frBut.butQuit \
  427.          -side left -fill x -expand true -padx 2m -pady 2m
  428. }
  429. # END SaveFile --------------------------------------------------------
  430.  
  431.  
  432. proc DirList { dirname } {
  433. #
  434. # displays a directory listing of the directory specified as 'dirname'
  435. # in the listbox of the main window
  436.  
  437.     if [file isdirectory $dirname] {
  438.  
  439.         # CLEAR LISTBOX
  440.         .frDir.lbxDir delete 0 end
  441.  
  442.         # DISPLAY DIRECTORY LISTING
  443.         set dirlist [exec ls -al $dirname]
  444.         foreach f [split $dirlist "\n"] {
  445.             .frDir.lbxDir insert end $f
  446.         }
  447.     }
  448. }
  449. # END DirList ---------------------------------------------------------
  450.  
  451.  
  452. proc TarList { file } {
  453. #
  454. # clears the directory listbox in the main window and displays a listing
  455. # of the files within the selected tar archive.  Note that the global
  456. # variable 'tarType' must be set to either "tar" or "tgz" in order for
  457. # the correct command line options to be specified to tar
  458.  
  459.     global tarType
  460.  
  461.     # CLEAR LISTBOX
  462.     .frDir.lbxDir delete 0 end
  463.  
  464.     # DISPLAY ARCHIVE LISTING
  465.     if { $tarType == "tar" } {
  466.         set tarlist [exec tar -tf $file]
  467.     } elseif { $tarType == "tgz" } {
  468.         set tarlist [exec tar -tzf $file]
  469.     } else {
  470.     }
  471.  
  472.     foreach i [split $tarlist "\n"] {
  473.         .frDir.lbxDir insert end $i
  474.     }
  475. }
  476. # END TarList ---------------------------------------------------------
  477.  
  478.  
  479. proc TarView { tarfile file } {
  480. #
  481. # displays a text viewer/editor in which the specified tar archive file
  482. # may be viewed, edited, saved to disk, or printed
  483.  
  484.     global fd wd ht 
  485.     global tarType
  486.     global savFilename
  487.     global lprCmd
  488.     global tmpFile
  489.  
  490.     # DEFINE TOPLEVEL WINDOW
  491.     toplevel .txt
  492.     wm title .txt "TarVu Viewer"
  493.  
  494.     # DEFINE LOCAL VARs
  495.     set tmpFile /tmp/tclvu.tmp
  496.     set ht 24
  497.     set wd 80
  498.     set savFilename "[pwd]/"
  499.  
  500.     # DEFINE FRAMES
  501.     frame .txt.frLbl -bd 2 -relief groove
  502.     frame .txt.frTxt -bd 2 -relief groove
  503.     pack  .txt.frLbl \
  504.           .txt.frTxt \
  505.           -side top -fill x -expand true -padx 2m -pady 2m
  506.  
  507.     # DEFINE FILE LABEL AND BUTTONS
  508.     label .txt.frLbl.lblFile -text "File: $file"
  509.     button .txt.frLbl.butDone -text "Done" -command { destroy .txt }
  510.     button .txt.frLbl.butPrnt -text "Print..." -command { PrintBuffer }
  511.     button .txt.frLbl.butSave -text "Save As..." -command { SaveBuffer }
  512.     button .txt.frLbl.butWide -text "Widen Window" -command {
  513.         set wd [expr $wd + 8]
  514.         .txt.frTxt.text configure -width $wd
  515.     }
  516.     button .txt.frLbl.butLong -text "Lengthen Window" -command {
  517.         set ht [expr $ht + 8]
  518.         .txt.frTxt.text configure -height $ht
  519.     }
  520.     pack  .txt.frLbl.lblFile -side left  -padx 2m -pady 2m
  521.     pack  .txt.frLbl.butDone \
  522.           .txt.frLbl.butPrnt \
  523.           .txt.frLbl.butSave \
  524.           .txt.frLbl.butLong \
  525.           .txt.frLbl.butWide \
  526.           -side right -padx 1m -pady 2m
  527.  
  528.     # DEFINE TEXT WIDGET AND SB's
  529.     scrollbar .txt.frTxt.sbY -command ".txt.frTxt.text yview" -orient vert
  530.     scrollbar .txt.frTxt.sbX -command ".txt.frTxt.text xview" -orient horiz
  531.     text .txt.frTxt.text -relief raised -width $wd -height $ht -bd 2 \
  532.         -yscrollcommand ".txt.frTxt.sbY set" -font 9x15 -wrap none \
  533.         -xscrollcommand ".txt.frTxt.sbX set"
  534.     pack .txt.frTxt.sbY  -side right  -fill y -expand true
  535.     pack .txt.frTxt.sbX -side bottom -fill x -expand true
  536.     pack .txt.frTxt.text -side left   -fill both -expand true
  537.  
  538.     # CREATE TMP FILE
  539.     if {$tarType == "tar"} {
  540.         exec tar -xOf $tarfile $file > $tmpFile
  541.     } elseif {$tarType == "tgz"} {
  542.         exec tar -xzOf $tarfile $file > $tmpFile
  543.     } else {
  544.     }
  545.  
  546.     # DISPLAY TMP FILE
  547.     .txt.frTxt.text delete 1.0 end
  548.     set fd [open $tmpFile]
  549.     while {![eof $fd]} {
  550.         .txt.frTxt.text insert end [read $fd 512]
  551.     }
  552.     close $fd
  553.     exec rm -f $tmpFile
  554. }
  555. # END TarView ---------------------------------------------------------
  556.  
  557.  
  558. proc PrintBuffer {} {
  559. #
  560. # displays a small dialog box allowing the user to input the print 
  561. # command.  It then prints the contents of the current edit buffer
  562. # of the TarView window
  563.  
  564.     global tmpFile
  565.     global lprCmd
  566.     
  567.     # SET VAR's
  568.     set tmpFile /tmp/tclvu.tmp
  569.  
  570.     # DEFINE TOPLEVEL WINDOW
  571.     toplevel .prtbuf
  572.     wm title .prtbuf "TclVu Printing Edit Buffer"
  573.  
  574.     # DEFINE FRAMES
  575.     frame .prtbuf.frEnt -relief groove -bd 2
  576.     frame .prtbuf.frBut -relief sunken -bd 2
  577.     pack  .prtbuf.frEnt \
  578.           .prtbuf.frBut \
  579.           -side top -fill x -expand false -padx 2m -pady 2m
  580.  
  581.     # DEFINE LPR COMMAND ENTRY BOX
  582.     label .prtbuf.frEnt.lbl -text "Enter print command: "
  583.     entry .prtbuf.frEnt.ent -textvariable lprCmd -width 24
  584.     pack  .prtbuf.frEnt.lbl -side left -expand false
  585.     pack  .prtbuf.frEnt.ent -side left -fill x -expand true
  586.  
  587.     # DEFINE PRINT AND CANCEL BUTTONS
  588.     button .prtbuf.frBut.butPrnt -text "Print" -command {
  589.  
  590.         # CREATE TMP FILE OF CURRENT BUFFER
  591.         set fd [open $tmpFile w]
  592.         puts $fd [.txt.frTxt.text get 1.0 end]
  593.         close $fd
  594.  
  595.         # PRINT THEN DELETE TMP FILE
  596.         eval exec $lprCmd $tmpFile
  597.         exec rm -f $tmpFile
  598.  
  599.         # CLOSE DIALOG WINDOW
  600.         destroy .prtbuf
  601.     }
  602.     button .prtbuf.frBut.butCncl -text "Cancel" -command { destroy .prtbuf }
  603.     pack .prtbuf.frBut.butPrnt \
  604.          .prtbuf.frBut.butCncl \
  605.          -side left -fill x -expand true -padx 2m -pady 2m
  606. }
  607. # END PrintBuffer -----------------------------------------------------
  608.  
  609.  
  610. proc SaveBuffer {} {
  611. #
  612. # displays a directory browser window from which the current editing buffer
  613. # may be saved or appended to a file
  614.  
  615.     global dirname
  616.     global sFilename
  617.     global tmpPWD
  618.  
  619.     # SET VARs
  620.     set dirname [pwd]
  621.     set sFilename "$dirname/"
  622.     set tmpPWD [pwd]
  623.  
  624.     # DEFINE TOPLEVEL WINDOW
  625.     toplevel .savbuf
  626.     wm title .savbuf "TclVu Saving Editing Buffer"
  627.  
  628.     # DEFINE FRAMES
  629.     frame .savbuf.frLbl -relief groove -bd 2
  630.     frame .savbuf.frLbx -relief groove -bd 2
  631.     frame .savbuf.frEnt -relief flat   -bd 2
  632.     frame .savbuf.frBut -relief sunken -bd 2
  633.     pack  .savbuf.frLbl \
  634.           .savbuf.frLbx \
  635.           .savbuf.frEnt \
  636.           .savbuf.frBut \
  637.           -side top -fill x -expand true -padx 2m -pady 2m
  638.  
  639.     # DEFINE TOPMOST DIRECTORY LABEL AND BUTTONS
  640.     label .savbuf.frLbl.lblDir -text "Directory: "
  641.     entry .savbuf.frLbl.entDir -textvariable dirname -width 72
  642.     button .savbuf.frLbl.butUp -text "Up.." -command {
  643.         cd ..
  644.         set dirname [pwd]
  645.         set sFilename "$dirname/"
  646.         set dirlist [exec ls -al $dirname]
  647.         .savbuf.frLbx.lbxDir delete 0 end
  648.         foreach i [split $dirlist "\n"] {
  649.             .savbuf.frLbx.lbxDir insert end $i
  650.         }
  651.     }
  652.     pack  .savbuf.frLbl.lblDir \
  653.           .savbuf.frLbl.entDir \
  654.           -side left -fill x -expand true -padx 2m -pady 2m
  655.     pack  .savbuf.frLbl.butUp -side right -expand false -padx 2m -pady 2m
  656.  
  657.     # DEFINE DIRECTORY ENTRYBOX <RETURN> BINDING
  658.     bind .savbuf.frLbl.entDir <Return> {
  659.         if [file isdirectory $dirname] {
  660.             cd $dirname
  661.             set sFilename "$dirname/"
  662.             set dirlist [exec ls -al $dirname]
  663.             .savbuf.frLbx.lbxDir delete 0 end
  664.             foreach i [split $dirlist "\n"] {
  665.                 .savbuf.frLbx.lbxDir insert end $i
  666.             }
  667.         } else {
  668.             set dirname [pwd]
  669.         }
  670.     }
  671.  
  672.     # DEFINE DIRECTORY LISTBOX AND SCROLLBAR
  673.     listbox .savbuf.frLbx.lbxDir -relief raised -bd 2 -yscrollcommand \
  674.         ".savbuf.frLbx.sbDir set" -width 72 -height 12 -font 8x13
  675.     scrollbar .savbuf.frLbx.sbDir -command ".savbuf.frLbx.lbxDir yview"
  676.     pack .savbuf.frLbx.sbDir -side right -fill y
  677.     pack .savbuf.frLbx.lbxDir -side left -fill x -expand true
  678.  
  679.     # DEFINE LISTBOX DOUBLE CLICK EVENT
  680.     bind .savbuf.frLbx.lbxDir <Double-Button-1> {
  681.         foreach i [split [selection get] \ ] {
  682.             lappend lst $i
  683.         }
  684.         set fname [lindex $lst [expr [llength $lst] -1]]
  685.  
  686.         if [file isdirectory $fname] {
  687.             cd $fname
  688.             set dirname [pwd]
  689.             set sFilename "$dirname/"
  690.             set dirlist [exec ls -al $dirname]
  691.             .savbuf.frLbx.lbxDir delete 0 end
  692.             foreach i [split $dirlist "\n"] {
  693.                 .savbuf.frLbx.lbxDir insert end $i
  694.             }
  695.         } elseif [file isfile $fname] {
  696.             set sFilename "$dirname/$fname"
  697.         } else {
  698.         }
  699.     }
  700.     # DEFINE LISTBOX SINGLE CLICK EVENT
  701.     bind .savbuf.frLbx.lbxDir <ButtonRelease-1> {
  702.             foreach i [split [selection get] \ ] {
  703.             lappend lst $i
  704.         }
  705.         set fname [lindex $lst [expr [llength $lst] -1]]
  706.  
  707.         if [file isfile $fname] {
  708.             set sFilename "$dirname/$fname"
  709.         } elseif [file isdirectory $fname] {
  710.             set sFilename "$dirname/"
  711.         } else {
  712.         }
  713.     }
  714.  
  715.     # GET INITIAL DIRECTORY LISTING
  716.     .savbuf.frLbx.lbxDir delete 0 end
  717.     set dirlist [exec ls -al $dirname]
  718.     foreach i [split $dirlist "\n"] {
  719.         .savbuf.frLbx.lbxDir insert end $i
  720.     }
  721.  
  722.     # DEFINE FILENAME ENTRY BOX
  723.     label .savbuf.frEnt.lbl -text "Filename: "
  724.     entry .savbuf.frEnt.ent -textvariable sFilename -width 72
  725.     pack  .savbuf.frEnt.lbl -side left -pady 2m
  726.     pack  .savbuf.frEnt.ent -side left -fill x -pady 0.5m
  727.  
  728.     # DEFINE OPERATION BUTTONS
  729.     # SAVE AS BUTTON
  730.     button .savbuf.frBut.butSave -text "Save As" -command {
  731.         if [file exists $sFilename] {
  732.             set sFilename "$dirname/"
  733.         } else {
  734.             set fd [open $sFilename w]
  735.             puts $fd [.txt.frTxt.text get 1.0 end]
  736.             close $fd
  737.             cd $tmpPWD
  738.             destroy .savbuf
  739.         }
  740.     }
  741.     # APPEND BUTTON
  742.     button .savbuf.frBut.butApnd -text "Append" -command {
  743.         if {![file isfile $sFilename]} {
  744.             set sFilename "$dirname/"
  745.         } else {
  746.             set fd [open $sFilename a+]
  747.             puts $fd [.txt.frTxt.text get 1.0 end]
  748.             close $fd
  749.             cd $tmpPWD
  750.             destroy .savbuf
  751.         }        
  752.     }
  753.     # QUIT BUTTON
  754.     button .savbuf.frBut.butQuit -text "Quit" -command {
  755.         cd $tmpPWD 
  756.         destroy .savbuf
  757.     }
  758.     pack .savbuf.frBut.butSave \
  759.          .savbuf.frBut.butApnd \
  760.          .savbuf.frBut.butQuit \
  761.          -side left -fill x -expand true -padx 2m -pady 2m
  762. }
  763. # END SaveBuffer ------------------------------------------------------
  764.  
  765.  
  766. #######################################################################
  767. # END PROCEDURE DEFINITIONS 
  768. #######################################################################
  769.  
  770. # MAIN PROGRAM
  771. CreateWindow
  772. set pathname [pwd]
  773. DirList $pathname
  774.